perm filename SEC.SAI[DIA,KMC] blob
sn#188666 filedate 1975-11-24 generic text, type T, neo UTF8
00100 BEGIN
00200 REQUIRE "IODEFS[1,BLF]" SOURCE_FILE;
00300
00400
00500 DEFINE ITT(X,N) = "FOR X←1 STEP 1 UNTIL N DO";
00600 DEFINE ∂=" &BLANK1& ";
00700 STRING BLANK1,BLANK10,BLANK20,DELIMSS,FORMFEED;
00800
00900
01000 INTEGER DICE, SW, P, P1, Q, Q1, I, I1, J, J1, K, K1, W, L, T, WFLAG;
01100 INTEGER NEXTL,NEXTA,LI,SSLEN,ATLEN,ERROR,IDUM,INCH1,INCH2,EOF1,EOF2;
01200 REAL R, RR, RRR;
01300 STRING S, SS, SSS,ST,SY,SV,FILENAME,SU,LASTNAME,LASTLINE,ZEROKS,TOPIC,LASTB,AREA;
01400 STRING S1,S2;
01500 PRELOAD_WITH [11] 0;
01600 INTEGER ARRAY AA[1:11];
01700 STRING ARRAY SA[1:15];
01800 INTEGER ARRAY DUMMAA[1:6,1:3];
01900
02000 STRING PROC RIGHTZ(INTEGER L; STRING S);
02100 RETURN(IF LN(S)<L THEN ZEROKS[1 TO L-LN(S)]&S ELSE S[1 TO L]);
02200
02300 STRING PROC OFFS(STRING S; INTEGER I);
02400 BEGIN STRING ST; INTEGER L; L←LENGTH(S);
02500 IF I<L THEN ST←S[I+1 TO L] ELSE ST←NULL; RETURN (ST) ; END;
02600
02700
02800
02900 BOOLEAN PROC EQS(STRING S);
03000 RETURN(IF EQU(S,NULL) OR EQU(S," ") THEN TRUE ELSE FALSE);
03100
03200 STRING PROC READIN(INTEGER CHAN);
03300 BEGIN STRING S; S←INPUT(CHAN,1);
03400 WHILE ¬EOF AND EQS(S) DO S←INPUT(CHAN,1);
03500 IF EOF THEN IF CHAN=INCH1 THEN EOF1←EOF ELSE EOF2←EOF; RETURN(S); END;
03600
03700 PROC OUTB(INTEGER CHAN; STRING S);
03800 BEGIN IF ¬EQU(SV,S[1 TO 6]) THEN BEGIN OUT(OUCH, NULL ↓ ); SV←S[1 TO 6]; END;
03900 OUT(OUCH, S); END;
04000
04100 STRING PROC READNOC(INTEGER I);
04200 BEGIN STRING S,SDUM; INTEGER FLAG; FLAG←0;
04300 WHILE ¬EOF AND ¬EOF1 AND ¬EOF2 AND FLAG=0 DO BEGIN S←READIN(I);
04400 IF EQU(S[1 TO 1],FORMFEED) THEN SDUM←LOP(S);
04500 IF EQU(S[1 TO 4],"(***") THEN FLAG←0
04600 ELSE IF EQU(S,NULL) THEN FLAG←0
04700 ELSE IF EQU(S," ") THEN FLAG←0
04800 ELSE FLAG←1; END;
04900 RETURN (S); END;
05000
05100
05200 PROC READCOMMENT(INTEGER I);
05300 BEGIN IF EQU(SS[1 TO 7], "COMMENT") THEN BEGIN
05400 WHILE ¬EQU(SS[2 TO 2],";") AND ¬EQU(SS[3 TO 3],";") AND ¬EOF1 AND ¬EOF2
05500 DO SS←READIN(I);
05600 SS←READIN(I);
05700 END; END;
05800
05900
06000 BOOLEAN PROC QCHECK(STRING S);
06100 IF S="T" OR S="H" OR S="S" THEN RETURN (TRUE) ELSE RETURN (FALSE);
06200
06300 BOOLEAN PROC CHECK(STRING S);
06400 BEGIN INTEGER I; I←LENGTH(S); IF I<2 THEN RETURN(FALSE);
06500
06600 IF I=2 AND EQU(S,"HE") THEN RETURN(TRUE) ;
06700 IF I=3 AND (EQU(S,"HIS") OR EQU(S,"HIM") OR EQU(S,"HER") OR EQU(S,"SHE"))
06800 THEN RETURN(TRUE) ;
06900 IF I=4 AND (EQU(S,"THEM") OR EQU(S,"HERS")) THEN RETURN(TRUE);
07000 IF (I=5 OR I=6) AND EQU(S[1 TO 5],"THEIR") THEN RETURN(TRUE);
07100 RETURN(FALSE);
07200 END;
07300
07400
07500
07600 FORMFEED← '14;
07700 ZEROKS←"000000000000";
07800 BLANKS←" ";
07900 BLANK1←" ";
08000 BLANK20←" ";
08100 BLANK10←" ";
08200 FLAG←0;
08300 STDBRK(INCH);
08400 DELIMSS← '15 & '12 & '40 & '11 & '14;
08500 SETBREAK(13, '12 & '40, '15, "INS");
08600 SETBREAK(14,DELIMSS & " ?.()","","INR");
08700 SETBREAK(15,"αλ","","INR");
08800
08900 COMMENT BREAKSETS 17 AND 18 ARE RESERVED FOR TEMPORARY USE;
09000
09100 SW←0; J←0;
09200 ITT(I,6) ITT(K,3) DUMMAA[I,K]←0;
09300 ITT(I,5) SA[I]←" ";
09400
09500 COMMENT ********************************* ;
09600
09700 WHILE TRUE DO BEGIN "TOPBLOCK"
09800
09900 S←ASK("H FOR HELP -- GO?");
10000
10100 IF EQU(S, "X") THEN DONE "TOPBLOCK";
10200
10300 IF EQU(S, "H") THEN BEGIN
10400
10500 SAY("A for replAcing pronouns with THEY " ↓ );
10600 SAY("B for inserting blank lines " ↓ );
10700 SAY("C for making a list of topics from PDAT " ↓ );
10800 SAY("D for deleting DIA files from DIA,KMC " ↓ );
10801 SAY("E for deleting ERR files from DIA,KMC " ↓ );
10900 SAY("G for appending files with file names " ↓ );
11000 SAY("U for making a list of unused from SOR and TOPICS " ↓ );
11100 SAY("I for making a list of stuff from PDAT for PDATB " ↓ );
11200 SAY("P for going thru DIA files " ↓ );
11212 SAY("Q for going thru DIA files and selecting inputs only " ↓ );
11300 SAY("S for going thru DIA files and collecting net stats " ↓ );
11400 SAY("T for testing something" ↓ ↓ );
11500
11600 END; COMMENT END OF H ROUTINE;
00100 COMMENT Q ROUTINE FOR FOR GOING THRU DIA FILES;
00200
00300 IF EQU(S,"Q") THEN BEGIN "Q"
00400
00500 SAY("selecting only input sentences from DIA files on DIA,KMC " ↓ );
00600 FILIN("PAR2.FIL[DIA,KMC]");
00700 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
00800 I←CVD(SS); RELEASE(INCH);
00850 SS←ASK("TOP NUMBER IS [P FOR PAR.FIL] ");
00875 IF EQU(SS,"P") THEN I←I ELSE I←CVD(SS);
00900 SAY("top number = " & CVS(I) ↓ );
01000 FILIN("THRU.FIL[DIA,KMC]");
01100 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
01200 J←CVD(SS); RELEASE(INCH);
01300 SAY("bottom number = " & CVS(J) ↓ );
01400 SS←ASK("Want to quit?"); IF EQU(SS,"Y") THEN DONE "TOPBLOCK";
01500
01600 FILIN("OUT.FIL[DIA,KMC]");
01700 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
01800 K←CVD(SS); RELEASE(INCH);
01900 FILOUT("OUT.FIL[DIA,KMC]"); OUT(OUCH,CVS(K+1) ↓ ); RELEASE(OUCH);
02000
02100 SS←"S" & CVS(K) & ".OUT[DIA,KMC]"; SAY("writing out on "&SS ↓ ); FILOUT(SS);
02200
02300 WHILE (J+1)≠I DO BEGIN "READDIA"
02400
02500 J←J+1;
02600 SS←"P"&CVS(J)&".DIA[DIA,KMC]"; COMMENT SAY("read "& SS ↓ );
02700 FILIN(SS);
02800 IF FLAG≠0 THEN BEGIN SAY(SS& " doesnt exist" ↓ ); CONTINUE "READDIA"; END;
02900 SS←INPUT(INCH,1); ST←NULL;
03000
03100 WHILE ¬EOF DO BEGIN "READFILE"
03200
03300 SV←ST; ST←SU←NULL;
03400 WHILE ¬EOF AND EQS(SS) DO SS←INPUT(INCH,1);
03500 WHILE ¬EOF AND ¬EQS(SS) AND EQU(ST,NULL) DO
03600 BEGIN ST←SU; SU←SS; SS←INPUT(INCH,1); END;
03700 COMMENT NOW HAVE INPUT IN ST, OUTPUT IN SU, PREVIOUS INPUT IN SV;
03800
03900 COMMENT SAY(ST ↓ ); S1←ST; S←NULL;
04000 COMMENT SAY(SU ↓ ↓ );
04100
04200 IF EQU(ST,NULL) OR EQU(ST[1 TO 2],"PD") THEN S←NULL
04300 ELSE S←"T";
04700
05400 IF EQU(S,"T") THEN
05500 OUT(OUCH, S1 ↓ );
05600
05700 END "READFILE" ;
05800
05900 SAY("thru "&CVS(J) ↓ ); RELEASE(INCH);
06000
06100 END "READDIA" ;
06200
06300 IF I≠(J+1) THEN J←J-1; COMMENT DIDN'T REALLY GET THRU JTH FILE;
06400 RELEASE(OUCH);
06500 FILOUT("THRU.FIL[DIA,KMC]"); OUT(OUCH,CVS(J) ↓ ); RELEASE(OUCH);
06600 SAY("thru P" & CVS(J) ↓ );
06700 SAY("done with DIA files" ↓ );
06800
06900 END "Q" ;
00100 COMMENT E ROUTINE FOR DELETING ERR FILES;
00200
00300 IF EQU(S,"E") THEN BEGIN "E"
00400 SAY(" deleting ERR files on[dia,kmc] " ↓ );
00500 FILIN("ERR.FIL");
00600 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
00700 W←CVD(SS); RELEASE(INCH);
00800 SAY("top no = " & CVS(W) ↓ );
00900 J←99;
01000 SAY("bottom no = " & CVS(J) ↓ );
01100
01200 WHILE J≠W DO BEGIN "READDIA"
01300
01400 J←J+1;
01500 SS←"P"&CVS(J)&".ERR"; COMMENT SAY("reading from "& SS ↓ );
01600 FLAG←0; FILIN(SS); I←FLAG;
01700 IF I≠0 THEN BEGIN COMMENT SAY(SS& " doesnt exist" ↓ ) ; END
01800 ELSE BEGIN "TESTERR"
01900 SAY(CVS(J) ↓ ); IDUM←0;
02000 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
02100 COMMENT SAY("X"&SS[1 TO 9]&"Y");
02200 IF EQU(SS[1 TO 9],"("" "" NIL")
02202 OR EQU(SS[1 TO 9],"("" PTYJOB")
02300 THEN RENAME(INCH,NULL,0,IDUM);
02400 IF IDUM THEN SAY("DELETE FAILED!!" ↓ ); END "TESTERR" ;
02500 RELEASE(INCH);
02600
02700 COMMENT SAY("thru "&CVS(J) ↓ );
02800
02900 END "READDIA" ;
03000 SAY("thru P" & CVS(J) ↓ );
03100 SAY("done with deleting ERR files" ↓ );
03200
03300 END "E" ;
00100 COMMENT D ROUTINE FOR DELETING DIA FILES;
00200
00300 IF EQU(S,"D") THEN BEGIN "D"
00400
00500 SAY("deleting DIA files on DIA,KMC " ↓ );
00600 FILIN("PAR2.FIL[DIA,KMC]");
00700 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
00800 W←CVD(SS); RELEASE(INCH);
00900 SAY("top no = " & CVS(W) ↓ );
01000
01100
01200 SS←ASK("WANT TO DELETE NORMAL DIA FILES [Y,N]? ");
01300 IF EQU(SS,"Y") THEN BEGIN "DEL"
01400
01500 SS←ASK("DELETE TO WHAT NUMBER [T FOR THRU.FIL]? ");
01600 IF EQU(SS,"T") THEN BEGIN
01700 FILIN("THRU.FIL[DIA,KMC]");
01800 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
01900 W←CVD(SS); RELEASE(INCH); END
02000 ELSE W←CVD(SS);
02100 SAY("top no = " & CVS(W) ↓ );
02200
02300 FILIN("DEL.FIL[DIA,KMC]");
02400 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
02500 J←CVD(SS); RELEASE(INCH);
02600 SAY("bottom no = " & CVS(J) ↓ );
02700
02800 WHILE (J+1)≠W DO BEGIN "READDIA"
02900
03000 J←J+1;
03100 SS←"P"&CVS(J)&".DIA[DIA,KMC]"; COMMENT SAY("reading from "& SS ↓ );
03200 FLAG←0; FILIN(SS); I←FLAG;
03300 IF I≠0 THEN SAY(SS& " doesnt exist" ↓ )
03400 ELSE BEGIN COMMENT SAY("deleting "&SS ↓ );
03450 IDUM←0; RENAME(INCH,NULL,0,IDUM);
03500 IF IDUM THEN SAY("DELETE FAILED!!" ↓ ); END;
03600 RELEASE(INCH);
03700 SAY("thru "&CVS(J) ↓ );
03800
03900 END "READDIA" ;
04000
04100 IF W≠(J+1) THEN J←J-1; COMMENT DIDN'T REALLY GET THRU JTH FILE;
04200 FILOUT("DEL.FIL[DIA,KMC]"); OUT(OUCH,CVS(J) ↓ ); RELEASE(OUCH);
04300 SAY("thru P" & CVS(J) ↓ );
04400 SAY("done deleting DIA files" ↓ );
04500
04600 END "DEL";
04700
04800 END "D" ;
00100 COMMENT S ROUTINE FOR FOR GOING THRU DIA FILES AND COLLECTING NET STATS ;
00200
00300 IF EQU(S,"S") THEN BEGIN "S"
00400
00500 SETBREAK(17,'12 & '15 & "(","","INS"); COMMENT THIS SCANS UNTIL ( CRLF ;
00600 SETBREAK(18,'12 & '15 & "?.()","","INS"); COMMENT THIS SCANS UNTIL ?.()CRLF ;
00700 SAY("Here we go thru DIA files on DIA,KMC to collect net stats " ↓ );
00800 FILIN("PAR2.FIL[DIA,KMC]");
00900 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
01000 I←CVD(SS); RELEASE(INCH);
01100 SAY("top number = " & CVS(I) ↓ );
01200 FILIN("STATS.FIL[DIA,KMC]");
01300 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
01400 J←CVD(SS); RELEASE(INCH);
01500 SAY("bottom number = " & CVS(J) ↓ );
01600 SS←ASK("Want to quit?"); IF EQU(SS,"Y") THEN DONE "TOPBLOCK";
01700
01800 LASTLINE←ASK("Tell me the dates ");
01900
02000 P←Q←0; COMMENT TO SAVE TIMES ;
02100
02200 WHILE (J+1)≠I DO BEGIN "READDIA"
02300
02400 J←J+1;
02500 SS←"P"&CVS(J)&".DIA[DIA,KMC]"; COMMENT SAY("reading "& SS ↓ );
02600 FILIN(SS);
02700 IF FLAG≠0 THEN BEGIN SAY(SS& " doesnt exist" ↓ ); CONTINUE "READDIA"; END;
02800
02900 SS←INPUT(INCH,1); ST←NULL; SS←INPUT(INCH,1);
03000
03100 WHILE ¬EOF DO BEGIN "READFILE"
03200
03300 WHILE ¬(NULL=SS) AND ¬(EQU(SS[1 TO 4],"NET ") OR EQU(SS[1 TO 7],"NONNET ")) DO
03400 SU←SCAN(SS,17,IDUM);
03500 IF SS THEN BEGIN SU←SCAN(SS,18,IDUM); ST←SU; END;
03600
03700 SS←INPUT(INCH,1);
03800
03900 END "READFILE" ;
04000
04100 COMMENT ******* OUT(OUCH,ST ↓ );
04200 SAY("thru "&CVS(J) ↓ ); RELEASE(INCH);
04300 IF EQU(ST[1 TO 6],"NONNET") THEN SU←ST[4 TO ∞] ELSE SU←ST;
04400 K←CVD(SU[5 TO ∞]);
04500 IF EQU(ST[1 TO 6],"NONNET") THEN P←P+K ELSE Q←Q+K; COMMENT P IS NONNET, Q IS NET;
04600
04700 END "READDIA" ;
04800
04900 IF I≠(J+1) THEN J←J-1; COMMENT DIDN'T REALLY GET THRU JTH FILE;
05000 LASTLINE← LASTLINE&" NONNET= " & CVS(P/1000) & ", NET= " & CVS(Q/1000) &" IN SECS ";
05100
05200 FILIN("STATSR.FIL[DIA,KMC]"); SS←INPUT(INCH,1);
05300 FILOUT("STATS9.FIL[DIA,KMC]");
05400 WHILE NOT EOF DO BEGIN OUT(OUCH,SS ↓ ); SS←INPUT(INCH,1); END;
05500 OUT(OUCH,LASTLINE ↓ ); RELEASE(OUCH);
05600 RENAME(INCH,NULL,0,IDUM); IF IDUM THEN SAY("DELETE OF STATS.FIL FAILED" ↓ );
05700 RELEASE(INCH);
05800 FILIN("STATS9.FIL[DIA,KMC]"); RENAME(INCH,"STATSR.FIL[DIA,KMC]",0,IDUM); RELEASE(INCH);
05900 IF IDUM THEN SAY("RENAME FAILED FOR STATS.FIL[DIA,KMC] " ↓ );
06000 FILOUT("STATS.FIL[DIA,KMC]"); OUT(OUCH,CVS(J) ↓ ); RELEASE(OUCH);
06100 SAY("thru P" & CVS(J) ↓ );
06200 SAY("done with DIA files" ↓ );
06300
06400 END "S" ;
00100 COMMENT U ROUTINE FOR GOING THRU SOR AND TOPICS FOR UNUSED ;
00200
00300 IF EQU(S,"U") THEN BEGIN "U"
00400
00500 INTEGER ARRAY IA[0:9999];
00600 ITT(I,9999) IA[I]←0; IA[0]←0; J←0; COMMENT J IS THE HIGHEST NUMBER;
00700
00800 SAY("This goes thru SOR and TOPICS and looks for unused " ↓ );
00900 SS←ASK("FILOUT="); FILOUT(SS);
01000
01100 FILENAME←ASK("FILIN[SOR]="); FILIN(FILENAME);
01200 SS←READIN(1); READCOMMENT(1);
01300
01400 WHILE NOT EOF DO BEGIN "SOR"
01500 SU←SCAN(SS,15,IDUM); IF SS THEN BEGIN SU←SS[2 TO 5]; I←CVD(SU); IA[I]←1;
01600 IF I>J THEN J←I; END;
01700 SS←READIN(1);
01800 END "SOR" ; RELEASE(INCH); SAY("thru file1 " ↓ );
01900
02000 FILENAME←ASK("FILIN[TOPICS]="); FILIN(FILENAME);
02100 SS←READIN(1); READCOMMENT(1);
02200
02300 WHILE NOT EOF DO BEGIN "TOPICS"
02400 SU←SCAN(SS,15,IDUM); IF SS THEN BEGIN SU←SS[2 TO 5]; I←CVD(SU);
02500 IA[I]←IA[I]+2; IF I>J THEN J←I; END;
02600 SS←READIN(1);
02700 END "TOPICS" ; RELEASE(INCH); SAY("thru file2 " ↓ );
02800
02900 SAY("highest number is " & CVS(J) ↓ );
03000 OUT(OUCH,"IN SOR, NOT IN PDAT " ↓ ↓ );
03100
03200 ITT(I,J) IF IA[I]=1 THEN OUT(OUCH, "λ" & RIGHTZ(4,CVS(I)) ↓ );
03300
03400 OUT(OUCH, NULL ↓ );
03500 OUT(OUCH,"IN PDAT, NOT IN SOR " ↓ ↓ );
03600
03700 ITT(I,J) IF IA[I]=2 THEN OUT(OUCH, "λ" & RIGHTZ(4,CVS(I)) ↓ );
03800
03900 RELEASE(OUCH);
04000 END "U" ;
00100 COMMENT I ROUTINE FOR GETTING THE IMPORTANT STUFF FROM PDAT ;
00200
00300 IF EQU(S,"I") THEN BEGIN "I"
00400
00500 SAY("This makes a list of stuff from PDAT for PDATB " ↓ );
00600
00700 FILENAME←ASK("FILIN="); FILIN(FILENAME);
00800 SS←ASK("FILOUT="); FILOUT(SS);
00900 SETBREAK(17,'12 & '15 & "?.()","","INR"); COMMENT THIS SCANS UNTIL ?.()CRLF ;
01000
01100 SS←INPUT(INCH,1);
01200 READCOMMENT(1);
01300
01400 WHILE NOT EOF DO BEGIN
01500
01600 ST←NULL;
01700
01800 IF EQU("(#B λ", SS[1 TO 5]) THEN BEGIN
01900 SU←INPUT(INCH,1);
02000 IF EQU(SU[2 TO 5],"PRED") THEN
02100 ST←"(DEFPROP " & SS[5 TO 10] & SU[7 TO ∞] & " UNIT)"
02200 ELSE IF EQU(SU[2 TO 6],"CLASS") THEN
02300 ST←"(DEFPROP " & SU[8 TO ∞] & SS[4 TO 9] & " IND)";
02400
02500 IF ¬EQU(ST,NULL) THEN OUT(OUCH,ST ↓ );
02600 END;
02700
02800 SS←INPUT(INCH,1);
02900
03000 END;
03100
03200 RELEASE(OUCH); RELEASE(INCH);
03300 END "I" ;
00100 COMMENT C ROUTINE FOR GETTING A LIST OF TOPICS FROM PDAT ;
00200
00300 IF EQU(S,"C") THEN BEGIN "C"
00400
00500 SAY("This makes a list of bondvalues and topics from PDAT " ↓ );
00600
00700 FILENAME←ASK("FILIN="); FILIN(FILENAME);
00800 SS←ASK("FILOUT="); FILOUT(SS);
00900 SETBREAK(17,'12 & '15 & "?.()","","INR"); COMMENT THIS SCANS UNTIL ?.()CRLF ;
01000
01100 SS←INPUT(INCH,1);
01200 READCOMMENT(1);
01300
01400 WHILE NOT EOF DO BEGIN
01500
01600 IF EQU("(#B λ", SS[1 TO 5]) THEN BEGIN SAY(SS ↓ );
01700 SU←SS[5 TO ∞]; ST←SCAN(SU,17,IDUM); ST← SS[5 TO 9] & " " & SU;
01800 SS←INPUT(INCH,1); IF ¬EQU(SS[2 TO 6],"TOPIC") THEN SS←INPUT(INCH,1);
01900 IF ¬EQU(SS[2 TO 6],"TOPIC") THEN SAY("ERROR " & ST ↓ );
02000 SU←SCAN(SS,17,IDUM);
02100 I←LENGTH(SS); IF I<8 THEN SU← '11 & '11 & '11 ELSE IF I<16 THEN SU← '11 & '11
02200 ELSE SU←'11;
02300 ST←SS & SU & ST; COMMENT (HOSPITAL) λ1112 (LOC I HOSP) ;
02400 OUT(OUCH,ST ↓ );
02500 END;
02600
02700 SS←INPUT(INCH,1);
02800
02900 END;
03000
03100 RELEASE(OUCH); RELEASE(INCH);
03200 END "C" ;
00100 COMMENT P ROUTINE FOR FOR GOING THRU DIA FILES;
00200
00300 IF EQU(S,"P") THEN BEGIN "P"
00400
00500 SAY("Here we go thru DIA files on DIA,KMC " ↓ );
00600 FILIN("PAR2.FIL[DIA,KMC]");
00700 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
00800 I←CVD(SS); RELEASE(INCH);
00900 SAY("top number = " & CVS(I) ↓ );
01000 FILIN("THRU.FIL[DIA,KMC]");
01100 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
01200 J←CVD(SS); RELEASE(INCH);
01300 SAY("bottom number = " & CVS(J) ↓ );
01400 SS←ASK("Want to quit?"); IF EQU(SS,"Y") THEN DONE "TOPBLOCK";
01500
01600 FILIN("OUT.FIL[DIA,KMC]");
01700 SS←INPUT(INCH,1); IF EQU(SS,NULL) THEN SS←INPUT(INCH,1);
01800 K←CVD(SS); RELEASE(INCH);
01900 FILOUT("OUT.FIL[DIA,KMC]"); OUT(OUCH,CVS(K+1) ↓ ); RELEASE(OUCH);
02000
02100 SS←"S" & CVS(K) & ".OUT[DIA,KMC]"; SAY("writing out on "&SS ↓ ); FILOUT(SS);
02200
02300 WHILE (J+1)≠I DO BEGIN "READDIA"
02400
02500 J←J+1;
02600 SS←"P"&CVS(J)&".DIA[DIA,KMC]"; SAY("reading from "& SS ↓ );
02700 FILIN(SS);
02800 IF FLAG≠0 THEN BEGIN SAY(SS& " doesnt exist" ↓ ); CONTINUE "READDIA"; END;
02900 SS←INPUT(INCH,1); ST←NULL;
03000
03100 WHILE ¬EOF DO BEGIN "READFILE"
03200
03300 SV←ST; ST←SU←NULL;
03400 WHILE ¬EOF AND EQS(SS) DO SS←INPUT(INCH,1);
03500 WHILE ¬EOF AND ¬EQS(SS) AND EQU(ST,NULL) DO
03600 BEGIN ST←SU; SU←SS; SS←INPUT(INCH,1); END;
03700 COMMENT NOW HAVE INPUT IN ST, OUTPUT IN SU, PREVIOUS INPUT IN SV;
03800
03900 SAY(ST ↓ ); S1←ST; S←NULL;
04000 SAY(SU ↓ ↓ );
04100
04200 IF EQU(ST,NULL) OR EQU(ST[1 TO 2],"PD") THEN SAY("ignore this " ↓ )
04300 ELSE S←ASK("do what? ");
04400 IF EQU(S,"H") THEN
04500 BEGIN SAY("Copy, Enter sentence, Previous sent, Done with Dialog, Xit" ↓ );
04600 S←ASK("do what?"); END;
04700
04800 IF EQU(S,"X") THEN DONE "READDIA";
04900 IF EQU(S,"D") THEN DONE "READFILE";
05000 IF EQU(S,"E") THEN S1←ASK("type in the new sentence ");
05100 IF EQU(S,"O") THEN BEGIN LODED(SV ↓ ); S1←ASK("edit ") END;
05200 IF EQU(S,"V") THEN BEGIN LODED(S1 ↓ ); S1←ASK("edit ") END;
05300 IF EQU(S,"P") THEN S1←SV;
05400 IF EQU(S,"E") OR EQU(S,"P") OR EQU(S,"C") OR EQU(S,"V") OR EQU(S,"O") THEN
05500 OUT(OUCH, S1 ↓ );
05600
05700 END "READFILE" ;
05800
05900 SAY("thru "&CVS(J) ↓ ); RELEASE(INCH);
06000
06100 END "READDIA" ;
06200
06300 IF I≠(J+1) THEN J←J-1; COMMENT DIDN'T REALLY GET THRU JTH FILE;
06400 RELEASE(OUCH);
06500 FILOUT("THRU.FIL[DIA,KMC]"); OUT(OUCH,CVS(J) ↓ ); RELEASE(OUCH);
06600 SAY("thru P" & CVS(J) ↓ );
06700 SAY("done with DIA files" ↓ );
06800
06900 END "P" ;
00100 COMMENT A ROUTINE FOR REPLACING PRONOUNS BY "THEY" ;
00200
00300 IF EQU(S,"A") THEN BEGIN "A"
00400
00500 SAY("This replaces pronouns by THEY " ↓ );
00600 SAY("pronouns replaced are HE HIM HIS HER SHE HERS THEIR THEM " ↓ );
00700
00800 FILENAME←ASK("FILIN="); FILIN(FILENAME);
00900 SS←ASK("FILOUT="); FILOUT(SS);
01000
01100 SS←INPUT(INCH,1); READCOMMENT(1);
01200
01300 WHILE NOT EOF DO BEGIN "REPLACE"
01400
01500 ST←NULL;
01600 SV←SCAN(SS,5,IDUM);
01700
01800 WHILE SS DO BEGIN "LINE"
01900 SU←SCAN(SS,14,IDUM);
02000 IF QCHECK(SU[1 TO 1]) AND CHECK(SU) THEN ST←ST&" THEY" ELSE ST←ST&" "&SU;
02100 SU←SCAN(SS,5,IDUM);
02200
02300 END "LINE" ;
02400 IF ¬EQU(ST,NULL) THEN ST←ST&". ";
02500
02600 OUT(OUCH,ST ↓ );
02700 SS←INPUT(INCH,1);
02800
02900 END "REPLACE" ;
03000
03100 RELEASE(OUCH); RELEASE(INCH);
03200 END "A" ;
00100 COMMENT G ROUTINE FOR APPENDING FILES ;
00200
00300 IF EQU(S,"G") THEN BEGIN "G"
00400
00500 SAY("This appends files and adds the name and comments to the first line " ↓ );
00600
00700 SS←ASK("FILOUT=");
00800 FILOUT(SS);
00900
01000 FILENAME←ASK("FILIN (CR FOR END)= ");
01100
01200 WHILE FILENAME DO BEGIN "READFILE"
01300
01400 SAY("reading from "&FILENAME ↓ );
01500 FILIN(FILENAME);
01600 OUT(OUCH,FILENAME ↓ ↓ );
01700 SS←READIN(INCH);
01800
01900 WHILE ¬EOF DO BEGIN "READLINE"
02000
02100 OUT(OUCH,SS ↓ );
02200 SS←READIN(INCH);
02300
02400 END "READLINE";
02500
02600 OUT( OUCH, '15 & '14 ); COMMENT CR AND FORM FEED;
02700 SAY("done with "&FILENAME ↓ );
02800 RELEASE(INCH);
02900 FILENAME←ASK("FILIN (CR FOR END)= ");
03000
03100 END "READFILE" ;
03200
03300 RELEASE(OUCH);
03400
03500 END "G" ;
00100 COMMENT B ROUTINE FOR SPECIAL MOD: PUTS IN BLANK LINES;
00200
00300 IF EQU(S,"B") THEN BEGIN "B"
00400
00500 SAY("This inserts a blank line between groups of lines which begin with" ↓ );
00600 SAY(" the same first 6 characters: (λ1234 in an ANS file " ↓ );
00700
00800 FILENAME←ASK("FILIN="); FILIN(FILENAME);
00900 SS←ASK("FILOUT="); FILOUT(SS);
01000
01100 SS←READIN(1); READCOMMENT(1);
01200
01300 WHILE NOT EOF DO BEGIN
01400
01500 OUTB(OUCH,SS ↓ );
01600 SS←READIN(1);
01700
01800 END;
01900
02000 RELEASE(OUCH); RELEASE(INCH);
02100 END "B" ;
02200
02300
02400 COMMENT " * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *";
02500
02600
02700 COMMENT T ROUTINE FOR TESTING THINGS;
02800
02900 IF EQU(S,"T") THEN BEGIN
03000
03100
03200
03300 END; COMMENT END OF S=T;
03400
03500
03600 END "TOPBLOCK" ; COMMENT END TO INFINITE LOOP;
03700
03800 COMMENT END OF PROGRAM;
03900 END;